home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok52 / oberonced / obced.mod < prev    next >
Text File  |  1993-11-04  |  14KB  |  504 lines
  1. (***************************************************************************
  2.  
  3.     :Program.    ObCED.mod
  4.     :Contents.   Communication with CED
  5.     :Author.     Achim Siebert
  6.     :Address.    Nobileweg 67 , 7000 Stuttgart 40
  7.     :Copyright.  Public Domain
  8.     :Language.   Oberon
  9.     :Translator. AmigaOberon A+L
  10.     :Imports.    CED, Req
  11.     :History.    Jan-1991; V1.3
  12.     :Usage.      ObCED c-[svbcrntmd1238ig] l-[bsmdi]
  13.                  ObCED [c][l][e][opt] | [next] | [prev] | [first] | [quit]
  14.  
  15. ****************************************************************************)
  16.  
  17. MODULE ObCED;
  18.  
  19. IMPORT
  20.        Req,
  21.        ExecSupport,
  22.        FileSystem,
  23.        I:Intuition,
  24.        Dos,
  25.        SecureDos,
  26.        s:SYSTEM,
  27.        Exec,
  28.        Strings,
  29.        Arguments,
  30.        CED;
  31.  
  32. VAR OldFile,PathFile: ARRAY Req.dsize+Req.fchars+8 OF CHAR;
  33.     ThisFile,ExecuteFile,EFile : ARRAY Req.fchars+8 OF CHAR;
  34.     doscommand : ARRAY Req.dsize+6 OF CHAR;
  35.     oldcompoptions,oldlinkoptions,compoptions,linkoptions,
  36.                    compdef,linkdef : ARRAY 30 OF CHAR;
  37.     tfile,errfile : FileSystem.File;
  38.     same,errfileopen,errorsYetLoaded,egalerror : BOOLEAN;
  39.     Ausgabefenster : Dos.FileHandlePtr;
  40.     i,fehleraktuell,fehlergesamt : INTEGER;
  41.     numlines : LONGINT;
  42.     msp, foundmsp, replmsp : Exec.MsgPortPtr;
  43.     OldDir,NewDir,DummyDir : Dos.FileLockPtr;
  44.     mymess : CED.CEDMsg;
  45.     mymessPtr : POINTER TO CED.CEDMsg;
  46.     msgstring : ARRAY 8 OF CHAR;
  47.     msgstringPtr : POINTER TO ARRAY 8 OF CHAR;
  48.     optionen : SHORTSET;
  49.     
  50. CONST  c = 0; l = 1; e = 2; opt = 3; next = 4; prev = 5; first = 6; quit = 7;
  51.        fehleranzahl = 170;
  52.        front = "cedtofront";       
  53.               
  54.        myportname = "OB_CED";
  55.        tfilename = "T:ObCED.Workfile";
  56.       
  57. VAR  Fehler : POINTER TO ARRAY fehleranzahl OF ARRAY 70 OF CHAR;
  58.  
  59.  
  60. PROCEDURE Halt;
  61.  
  62. BEGIN
  63.  
  64.  HALT(20);
  65.  
  66. END Halt;
  67.  
  68.  
  69. PROCEDURE PutCED(command : ARRAY OF CHAR);
  70.  
  71. BEGIN
  72.  
  73.    IF NOT CED.PutMsg(command) THEN Halt END;
  74.  
  75. END PutCED;
  76.  
  77.  
  78. PROCEDURE GetFirstArgs():BOOLEAN;
  79.  
  80. VAR k : INTEGER;
  81.  
  82. BEGIN
  83.  
  84.    i := Arguments.NumArgs();
  85.    k := 1;
  86.    LOOP
  87.       IF k > i THEN 
  88.          RETURN TRUE;
  89.       END;
  90.       Arguments.GetArg(k,doscommand);
  91.       IF doscommand[1] = "-" THEN
  92.          CASE doscommand[0] OF
  93.             "c","l": 
  94.                      IF doscommand[0] = "c" THEN
  95.                         COPY(doscommand,compdef);
  96.                         Strings.Delete(compdef,0,1);
  97.                         Strings.AppendChar(compdef," ");
  98.                      ELSE
  99.                         COPY(doscommand,linkdef);
  100.                         Strings.Delete(linkdef,0,1);
  101.                         Strings.AppendChar(linkdef," ");
  102.                      END;
  103.          ELSE
  104.             RETURN FALSE;
  105.          END;
  106.       ELSE 
  107.          RETURN FALSE;
  108.       END;
  109.       INC(k);
  110.    END;
  111.       
  112. END GetFirstArgs;
  113.  
  114. PROCEDURE GetArgs():BOOLEAN;
  115.  
  116. BEGIN
  117.  
  118.    i := Arguments.NumArgs();
  119.    IF i = 1 THEN
  120.       Arguments.GetArg(1,msgstring);
  121.       Strings.Upper(msgstring);
  122.       RETURN TRUE;
  123.    END;
  124.    RETURN FALSE;
  125.    
  126. END GetArgs;
  127.  
  128. PROCEDURE Auswertung():BOOLEAN;
  129.  
  130.    PROCEDURE Occurs(what: ARRAY OF CHAR):BOOLEAN;
  131.       
  132.    BEGIN
  133.    
  134.       RETURN Strings.Occurs(msgstring,what) # -1;
  135.    
  136.    END Occurs;
  137.  
  138. BEGIN
  139.  
  140.    optionen := SHORTSET{};
  141.    IF Occurs("NEXT")  THEN INCL(optionen,next); RETURN TRUE;END;
  142.    IF Occurs("FIRST") THEN INCL(optionen,first);RETURN TRUE;END;
  143.    IF Occurs("PREV")  THEN INCL(optionen,prev); RETURN TRUE;END;
  144.    IF Occurs("QUIT")  THEN INCL(optionen,quit); RETURN TRUE;END;
  145.    IF Occurs("OPT")THEN INCL(optionen,opt);  END;
  146.    IF Occurs("C")  THEN INCL(optionen,c); END;
  147.    IF Occurs("L")  THEN INCL(optionen,l); END;
  148.    IF Occurs("E")  THEN INCL(optionen,e); END;
  149.    IF (c IN optionen) OR (l IN optionen) OR (e IN optionen) THEN RETURN TRUE;
  150.    ELSE RETURN FALSE END;
  151.  
  152. END Auswertung;
  153.  
  154.  
  155. PROCEDURE CloseErrfile();
  156.  
  157. BEGIN
  158.  
  159.    IF errfileopen THEN
  160.       IF NOT FileSystem.Close(errfile) THEN Halt; END;
  161.       errfileopen := FALSE;
  162.    END;
  163.  
  164. END CloseErrfile;
  165.  
  166.  
  167. PROCEDURE LadeFehler();
  168.  
  169. CONST fehlerfilename = "OBERON:Fehler-Meldungen";
  170.  
  171. BEGIN
  172.  
  173.    NEW(Fehler); IF Fehler = NIL THEN Halt END;
  174.    IF NOT FileSystem.Open(errfile,fehlerfilename,FALSE) THEN
  175.       PutCED("Okay1 OBERON:Fehler-Meldungen nicht gefunden!");
  176.    ELSE
  177.       errfileopen := TRUE;
  178.       i := 0;
  179.       LOOP
  180.          IF NOT FileSystem.ReadString(errfile,Fehler[i]) THEN EXIT; END;
  181.          INC(i); IF i = fehleranzahl THEN EXIT END;
  182.       END;
  183.       CloseErrfile;
  184.    END;
  185.  
  186. END LadeFehler;
  187.  
  188. PROCEDURE ZeigeFehler(fnp:INTEGER);
  189.  
  190. TYPE Fehlerblock = STRUCT
  191.                      nummer,zeile,spalte : INTEGER;
  192.                    END;
  193.  
  194. VAR  fehlrec : Fehlerblock;
  195.  
  196.    PROCEDURE ShowErr();
  197.  
  198.    TYPE Jumptoblock = STRUCT
  199.                          int1,int2 : INTEGER;
  200.                       END;
  201.    VAR jumprec : Jumptoblock;
  202.  
  203.    BEGIN
  204.          
  205.       jumprec.int1 := fehlrec.zeile;
  206.       jumprec.int2 := fehlrec.spalte;
  207.       IF Req.Format(doscommand,"Jumpto %d %d",s.ADR(jumprec))#0 THEN END;
  208.       PutCED(doscommand);
  209.       PutCED("left");
  210.       jumprec.int1 := fehleraktuell;
  211.       jumprec.int2 := fehlergesamt;
  212.       IF Req.Format(doscommand,"Okay1 Fehler Nr. %d von %d:\n",s.ADR(jumprec))#0 THEN END;
  213.       Strings.Append(doscommand,Fehler[fehlrec.nummer]);
  214.       PutCED(doscommand);
  215.  
  216.    END ShowErr;
  217.  
  218. BEGIN
  219.  
  220. IF NOT errorsYetLoaded THEN LadeFehler; errorsYetLoaded := TRUE; END;
  221. IF fnp = first THEN
  222.    CloseErrfile;
  223.    IF FileSystem.Open(errfile,EFile,FALSE) THEN
  224.       errfileopen := TRUE;
  225.       fehlergesamt := SHORT(FileSystem.Size(errfile) DIV 6);
  226.    ELSE
  227.       Halt;
  228.    END;
  229. END;
  230. IF CED.GetNumber("Status 17") # numlines THEN
  231.    PutCED("okay1 Anzahl der Zeilen im File hat sich geändert!\nKorrekte Fehleranzeige nicht mehr möglich.");
  232.    RETURN;
  233. END;
  234. CASE fnp OF
  235.    first : fehleraktuell := 1;
  236.            IF FileSystem.Move(errfile,0) AND FileSystem.Read(errfile,fehlrec) THEN
  237.               IF (fehlergesamt = 1) AND (fehlrec.nummer=96) THEN
  238.                 egalerror := TRUE;
  239.               ELSE
  240.                  PutCED(front);
  241.                  ShowErr();
  242.               END;
  243.            ELSE Halt;
  244.            END;
  245.    |next : INC(fehleraktuell);
  246.            IF fehleraktuell <= fehlergesamt THEN
  247.               IF NOT FileSystem.Read(errfile,fehlrec) THEN Halt END;
  248.               ShowErr();
  249.            ELSE
  250.               PutCED("okay1 Keine weiteren Fehler!");
  251.               DEC(fehleraktuell);
  252.            END;
  253.    |prev : DEC(fehleraktuell);
  254.            IF fehleraktuell <= 0 THEN
  255.               PutCED("okay1 Keine vorausgehenden Fehler!");
  256.               IF NOT FileSystem.Move(errfile,0) THEN Halt END;
  257.               fehleraktuell := 0;
  258.            ELSE
  259.               IF FileSystem.Move(errfile,(fehleraktuell-1)*6) THEN
  260.                  IF NOT FileSystem.Read(errfile,fehlrec) THEN Halt END;
  261.                  ShowErr();
  262.               ELSE Halt;
  263.               END;
  264.            END;
  265. ELSE
  266. END;
  267.  
  268. END ZeigeFehler;
  269.  
  270. PROCEDURE MakeExecuteTFile();
  271.  
  272. VAR Eingabe : Dos.FileHandlePtr;
  273.  
  274. BEGIN
  275.  
  276.    IF NOT (FileSystem.Open(tfile,tfilename,TRUE) AND
  277.       FileSystem.WriteString(tfile,"Path OBERON: add\nStack 30000") AND
  278.       FileSystem.WriteString(tfile,doscommand) AND
  279.       FileSystem.WriteString(tfile,"Stack 4000") AND
  280.       FileSystem.Close(tfile)) THEN Halt END;
  281.    Eingabe := Dos.Open(tfilename,Dos.oldFile);
  282.    IF Eingabe = NIL THEN Halt; END;
  283.    IF NOT Dos.Execute("",Eingabe,Ausgabefenster) THEN Dos.Close(Eingabe); Halt; END;
  284.    Dos.Close(Eingabe);
  285.    IF Dos.DeleteFile(tfilename) THEN END;
  286.  
  287. END MakeExecuteTFile;
  288.  
  289. PROCEDURE Action();
  290.  
  291.    PROCEDURE FensterZu();
  292.  
  293.    BEGIN
  294.  
  295.      PutCED(front);
  296.      Dos.Close(Ausgabefenster); Ausgabefenster := NIL;
  297.  
  298.    END FensterZu;
  299.  
  300. BEGIN
  301.  
  302. IF quit IN optionen THEN HALT(0);END;
  303. IF c IN optionen THEN
  304.    OldFile := "";
  305.    CloseErrfile;
  306.    PutCED("Save ");
  307. END;
  308. same := FALSE;
  309. CED.GetString("Status 19",PathFile);
  310. Strings.Upper(PathFile);
  311. IF (Strings.Occurs(PathFile,".MOD") = -1) THEN RETURN END;
  312. IF PathFile = OldFile THEN same := TRUE ELSE OldFile := PathFile END;
  313. IF NOT same THEN
  314.    numlines := CED.GetNumber("Status 17"); IF numlines = 0 THEN RETURN END;
  315.    CED.GetString("Status 21",ThisFile); IF ThisFile = "" THEN Halt END;
  316.    PathFile := "";
  317.    CED.GetString("Status 20",PathFile);
  318.    Strings.Upper(PathFile);
  319.    EFile := ThisFile;
  320.    Strings.AppendChar(EFile,"E");
  321.    IF Strings.Occurs(PathFile,":") = -1 THEN
  322.       CED.GetString("Status 75",doscommand);
  323.       Strings.Insert(PathFile,0,doscommand);
  324.    END;
  325.    IF Strings.OccursPos(PathFile,"/TXT",Strings.Length(PathFile)-4) # -1 THEN
  326.       Strings.Delete(PathFile,Strings.Length(PathFile)-4,4);
  327.       Strings.Insert(EFile,0,"txt/");
  328.    ELSE
  329.       IF Strings.OccursPos(PathFile,":TXT",Strings.Length(PathFile)-4) # -1 THEN
  330.          Strings.Delete(PathFile,Strings.Length(PathFile)-3,3);
  331.          Strings.Insert(EFile,0,"txt/");
  332.       END;
  333.    END;
  334.    CloseErrfile;
  335.    DummyDir := Dos.CurrentDir(OldDir);
  336.    IF NewDir # NIL THEN SecureDos.UnLock(NewDir);END;
  337.    NewDir := SecureDos.Lock(PathFile,Dos.sharedLock);
  338.    IF NewDir = NIL THEN Halt END;
  339.    DummyDir := Dos.CurrentDir(NewDir);
  340. END;
  341. IF (c IN optionen) OR (l IN optionen) OR (e IN optionen) THEN
  342.    compoptions := compdef; linkoptions := linkdef;
  343.    IF (c IN optionen) AND (opt IN optionen) THEN
  344.       IF oldcompoptions # "" THEN
  345.          compoptions := oldcompoptions;
  346.       ELSE compoptions := "svbcrntmdg1238io";
  347.       END;
  348.       PutCED(front);
  349.       doscommand := "getstring ";
  350.       Strings.Append(doscommand,compoptions);
  351.       Strings.Append(doscommand," Compiler-Optionen:");
  352.       CED.GetString(doscommand,compoptions);
  353.       IF compoptions # "" THEN
  354.          oldcompoptions := compoptions;
  355.          Strings.Insert(compoptions,0,"-");
  356.          Strings.AppendChar(compoptions," ");
  357.       END;
  358.    END;
  359.    IF (l IN optionen) AND (opt IN optionen) THEN
  360.       IF oldlinkoptions # "" THEN
  361.          linkoptions := oldlinkoptions;
  362.       ELSE
  363.          linkoptions := "";
  364.          IF (c IN optionen) AND (compoptions # "") THEN
  365.             Strings.Upper(compoptions);
  366.             IF Strings.Occurs(compoptions,"M") # -1 THEN
  367.                linkoptions := "m";
  368.             END;
  369.             IF Strings.Occurs(compoptions,"D") # -1 THEN
  370.                Strings.AppendChar(linkoptions,"d");
  371.             END;
  372.             IF Strings.Occurs(compoptions,"I") # -1 THEN
  373.                Strings.AppendChar(linkoptions,"i");
  374.             END;
  375.          END;
  376.       END;
  377.       IF linkoptions = "" THEN linkoptions := "bs" END;
  378.       PutCED(front);
  379.       doscommand := "getstring ";
  380.       Strings.Append(doscommand,linkoptions);
  381.       Strings.Append(doscommand," Linker-Optionen:");
  382.       CED.GetString(doscommand,linkoptions);
  383.       IF linkoptions # "" THEN
  384.          oldlinkoptions := linkoptions;
  385.          Strings.Insert(linkoptions,0,"-");
  386.          Strings.AppendChar(linkoptions," ");
  387.       END;
  388.    END;
  389.    Ausgabefenster := Dos.Open("CON:20/0/600/200/OBCed<->CED",Dos.newFile);
  390.    IF Ausgabefenster = NIL THEN Halt END;
  391.    IF I.WBenchToFront() THEN END;
  392.    IF (c IN optionen) THEN
  393.       doscommand := "Oberon ";
  394.       Strings.Append(doscommand,compoptions);
  395.       Strings.Append(doscommand,ThisFile);
  396.       MakeExecuteTFile();
  397.       IF FileSystem.Exists(EFile) THEN
  398.          egalerror := FALSE;
  399.          ZeigeFehler(first); IF NOT egalerror THEN FensterZu;RETURN;END;
  400.       END;
  401.    END;
  402.    IF (l IN optionen) OR (e IN optionen) THEN
  403.       ExecuteFile := ThisFile;
  404.       Strings.Delete(ExecuteFile,Strings.Length(ExecuteFile)-4,4);
  405.       IF (l IN optionen) THEN
  406.          doscommand := "OLink ";
  407.          Strings.Append(doscommand,linkoptions);
  408.          Strings.Append(doscommand,ExecuteFile);
  409.          MakeExecuteTFile();
  410.       END;
  411.       IF (e IN optionen) THEN
  412.          IF (opt IN optionen) THEN
  413.             doscommand := "getstring ";
  414.             Strings.Append(doscommand,ExecuteFile);
  415.             Strings.Append(doscommand," Programm-Aufruf:");
  416.             PutCED(front);
  417.             CED.GetString(doscommand,doscommand);
  418.             IF doscommand # "" THEN
  419.                IF I.WBenchToFront() THEN END;
  420.                IF Dos.Execute(doscommand,NIL,Ausgabefenster) THEN
  421.                   FensterZu; RETURN;
  422.                ELSE Halt;
  423.                END;
  424.             ELSE FensterZu; RETURN;
  425.             END;
  426.          ELSE
  427.             IF Dos.Execute(ExecuteFile,NIL,Ausgabefenster) THEN
  428.                FensterZu; RETURN;
  429.             ELSE Halt;
  430.             END;
  431.          END;
  432.       ELSE FensterZu; RETURN;
  433.       END;
  434.    ELSE
  435.       FensterZu; RETURN;
  436.    END;
  437. ELSE
  438.    IF FileSystem.Exists(EFile) THEN
  439.      IF (next IN optionen) AND same THEN ZeigeFehler(next);
  440.      ELSIF (prev IN optionen) AND same THEN ZeigeFehler(prev);
  441.      ELSE ZeigeFehler(first);
  442.      END;
  443.    ELSE
  444.      PutCED(front);
  445.      PutCED("okay1 Keine Fehlerdatei gefunden!");RETURN;
  446.    END;
  447. END;
  448.  
  449. END Action;
  450.  
  451. BEGIN
  452.    optionen := SHORTSET{};
  453.    foundmsp := Exec.FindPort(myportname);
  454.    IF foundmsp=NIL THEN
  455.       msp := ExecSupport.CreatePort(myportname,0);
  456.       IF msp = NIL THEN Halt END;
  457.       OldDir := SecureDos.oldCurrentDir;
  458.       IF OldDir = NIL THEN Halt END;
  459.       errfileopen := FALSE; errorsYetLoaded := FALSE;
  460.       fehleraktuell := 1;
  461.       IF NOT GetFirstArgs() THEN Halt();END;
  462.       LOOP
  463.          msgstring := "";
  464.          REPEAT
  465.             Exec.WaitPort(msp);
  466.             mymessPtr := Exec.GetMsg(msp);
  467.          UNTIL mymessPtr # NIL;
  468.          IF mymessPtr^.args[0] # NIL THEN
  469.             msgstringPtr := mymessPtr.args[0];
  470.             IF msgstringPtr # NIL THEN
  471.                COPY(msgstringPtr^,msgstring);
  472.             END;
  473.          END;
  474.          Exec.ReplyMsg(mymessPtr);
  475.          IF Auswertung() THEN
  476.             Action();
  477.          END;
  478.       END;
  479.    ELSE
  480.       replmsp := ExecSupport.CreatePort("",0);
  481.       IF replmsp = NIL THEN Halt END;
  482.       mymess.cmNode.node.type:=Exec.message;
  483.       mymess.cmNode.length:=s.SIZE(CED.CEDMsg);
  484.       mymess.cmNode.replyPort:=replmsp;
  485.       IF NOT GetArgs() THEN msgstring := "QUIT";END;
  486.       NEW(msgstringPtr);
  487.       IF msgstringPtr = NIL THEN Halt END;
  488.       mymess.args[0] := msgstringPtr;
  489.       COPY(msgstring,msgstringPtr^);
  490.       Exec.PutMsg(foundmsp,s.ADR(mymess));
  491.       Exec.WaitPort(replmsp);
  492.       ExecSupport.DeletePort(replmsp);
  493.       DISPOSE(msgstringPtr);
  494.    END;
  495.  
  496. CLOSE
  497.  
  498.    CloseErrfile;
  499.    IF NewDir # NIL THEN SecureDos.UnLock(NewDir);END;
  500.    IF msp # NIL THEN ExecSupport.DeletePort(msp);END;
  501.    IF Ausgabefenster # NIL THEN Dos.Close(Ausgabefenster) END;
  502.  
  503. END ObCED.
  504.